home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / merge.tcl.z / merge.tcl
Encoding:
Text File  |  1999-04-16  |  16.2 KB  |  495 lines
  1.  
  2. # TCL Library for tkCVS
  3.  
  4. #
  5. # $Id: merge.tcl,v 1.5 1995/11/15 04:30:11 davide Exp $
  6. #
  7.  
  8. proc merge_setup {} {
  9. # By: Eugene Lee, Aerospace Corporation, 11/12/95
  10.   global cvsglb cvsroot GetVenModule from_to sel_to
  11. #puts "merge_setup entered"
  12.   toplevel .merge
  13.   
  14.   frame .merge.left
  15.   frame .merge.right
  16.   frame .merge.vendor -relief groove -border 2
  17.   frame .merge.down -relief groove -border 2
  18.   frame .merge.feedback -relief groove -border 2
  19.  
  20.   pack .merge.feedback -side bottom -fill x -expand yes
  21.   pack .merge.down -side bottom -fill x -expand yes  
  22.   pack .merge.vendor -side bottom -fill x -expand yes
  23.   pack .merge.left   -side left
  24.   pack .merge.right  -side right -fill x -expand yes 
  25.  
  26.   label .merge.left.lcwd      -text "Current Directory"   -anchor w
  27.   label .merge.left.lmodule   -text "Module Location"    -anchor w
  28.   
  29.   entry .merge.right.tcwd      -relief sunken -width 40;  # use with cwd later
  30.   entry .merge.right.tmodule   -width 40;           # use with module_dir later
  31.   
  32.   pack .merge.left.lcwd       -side top   -fill x -pady 3
  33.   pack .merge.left.lmodule    -side top   -fill x
  34.   pack .merge.right.tcwd      -side top   -fill x -pady 3
  35.   pack .merge.right.tmodule   -side top   -fill x
  36.   
  37.   frame .merge.vendor.name 
  38.   pack .merge.vendor.name -side top -fill x -expand yes
  39.   label .merge.vendor.name.l -text "Vendor Module" -anchor w
  40.   entry .merge.vendor.name.e -relief sunken 
  41.   pack .merge.vendor.name.l -side left -fill x -pady 3
  42.   pack .merge.vendor.name.e -side right -anchor w -fill x -pady 3 -expand yes
  43.   .merge.vendor.name.e config -state disabled
  44. #  button .merge.vendor.b -text \
  45. #    "Select Module With Vendor Code From Repository" -anchor w \
  46. #    -command "GVM_selector"
  47.   button .merge.vendor.b -text \
  48.     "Select Module With Vendor Code From Repository" -anchor w \
  49.     -command "venselect_run"
  50.   pack .merge.vendor.b -side top -ipadx 2 -ipady 2  \
  51.     -padx 4 -pady 4  
  52.   frame .merge.vendor.l
  53.   frame .merge.vendor.r
  54.   pack .merge.vendor.l .merge.vendor.r -side left 
  55.   
  56.   foreach i {l r} {
  57.     if { $i == "l" } {
  58.       set x "From"
  59.     } else {
  60.       set x "To"
  61.     }
  62.     label .merge.vendor.$i.rev -text "$x Revision Tags"
  63.     pack .merge.vendor.$i.rev -side top
  64.     
  65.     frame .merge.vendor.$i.scroll 
  66.       eval {listbox .merge.vendor.$i.scroll.list \
  67.       -yscrollcommand [list .merge.vendor.$i.scroll.sy set] \
  68.       -xscrollcommand [list .merge.vendor.$i.scroll.sx set]} \
  69.       -relief sunken -width 40 -height 15
  70.       scrollbar .merge.vendor.$i.scroll.sx -orient horizontal \
  71.         -command [list .merge.vendor.$i.scroll.list xview] \
  72.         -relief sunken
  73.       scrollbar .merge.vendor.$i.scroll.sy -orient vertical \
  74.         -command [list .merge.vendor.$i.scroll.list yview] \
  75.         -relief sunken
  76.         pack .merge.vendor.$i.scroll.sx -side bottom -fill x
  77.         pack .merge.vendor.$i.scroll.sy -side right -fill y
  78.         pack .merge.vendor.$i.scroll.list -side left -fill both -expand true
  79.     pack .merge.vendor.$i.scroll -side top
  80.     
  81.     frame .merge.vendor.$i.f
  82.     pack .merge.vendor.$i.f -side bottom 
  83.     label .merge.vendor.$i.f.l -text $x
  84.     if { $i == "l" } {
  85.     
  86.       label .merge.vendor.$i.f.s -textvariable merge(from) -relief sunken \
  87.         -width 15
  88.     } else {
  89.       label .merge.vendor.$i.f.s -textvariable merge(to) -relief sunken \
  90.         -width 15
  91.     }
  92.     
  93.     pack .merge.vendor.$i.f.l -side left -padx 3 -pady 3
  94.     pack .merge.vendor.$i.f.s -side left -pady 3
  95.   }
  96.     
  97.   button .merge.ok -text "OK" -command do_merge
  98.   button .merge.quit -text "Quit" -command { wm withdraw .merge }
  99.   pack .merge.ok .merge.quit -in .merge.down -side left \
  100.     -ipadx 2 -ipady 2 -padx 4 -pady 4 -fill both -expand 1
  101.     
  102.   entry .merge.feedback.e  
  103.   pack .merge.feedback.e -fill x -expand yes
  104.   .merge.feedback.e configure -text "Hello"
  105.     
  106.   bind .merge.vendor.l.scroll.list <Double-1> {
  107.     get_j .merge.vendor.l.scroll.list left
  108.   }
  109.   bind .merge.vendor.r.scroll.list <Double-1> {
  110.     get_j .merge.vendor.r.scroll.list right
  111.   }
  112.   
  113.   wm withdraw .merge
  114.   wm title .merge "Module Level Merge With Vendor Code" 
  115.   wm minsize .merge 30 10
  116.   
  117. }
  118.  
  119. proc get_j { list side} {
  120. # Written by Eugene A. Lee, Aerospace Corp., 12/20/94
  121.     global merge
  122.     if {[string compare [$list curselection] ""] \
  123.        == 0} return
  124.  
  125.     set Sel [$list get [$list curselection]]
  126. #puts "side=$side"
  127.     if {$side == "left"} {
  128.        set merge(from) [lindex [split $Sel] 0]
  129.     } else {
  130.        set merge(to) [lindex [split $Sel] 0]
  131.     }
  132. }
  133.  
  134. proc put_rev_tags {} {
  135. # Written by Eugene A. Lee, Aerospace Corp., 11/12/95
  136.   #Called by button .venselect.ok in venget.tcl 
  137.     global cvsroot merge venselect_mcode location
  138.     set tmpwdir [eval pwd]
  139. #puts "tmpwdir=$tmpwdir"
  140. #puts "venselect_mcode=$venselect_mcode"
  141.     .merge.vendor.l.scroll.list delete 0 end
  142.     .merge.vendor.r.scroll.list delete 0 end
  143.     # Find directory where venselect_mcode is.
  144.     set dir $cvsroot/$location($venselect_mcode)
  145. #puts "From put_rev_tags, dir=$dir"
  146.     cd $dir
  147.     get_rv_tags r_tag_list v_tag_list
  148. #puts "r_tag_list=$r_tag_list"
  149.     cd $tmpwdir
  150.     if { [info exists r_tag_list] == 0 } {
  151.       foreach i {l r} {
  152.         .merge.vendor.$i.scroll.list insert end "No revision tags found"
  153.       }
  154.     } else {
  155.       for {set i 0} {$i < [llength $r_tag_list]} {incr i} {
  156.         set tmp [lindex $r_tag_list $i]
  157.         .merge.vendor.l.scroll.list insert end $tmp
  158.         .merge.vendor.r.scroll.list insert end $tmp
  159.       }
  160.     }
  161. }
  162. proc merge_run {} {
  163.   global cwd module_dir
  164. #puts "merge_run invoked"
  165. #puts "cwd=$cwd"
  166. #puts "module_dir=$module_dir"
  167.   if {$module_dir == "Not a CVS directory."} {
  168.     cvserror $module_dir
  169.     return
  170.   }
  171.   .merge.right.tcwd configure -text cwd
  172.   .merge.right.tmodule configure -text module_dir
  173.   wm deiconify .merge
  174. } 
  175.  
  176. proc do_merge {} {
  177.   global merge
  178. #  puts "Entered do_merge"
  179. #  puts "pwd=[exec pwd]"
  180.   set merge(3rd_party) [.merge.vendor.name.e get]
  181.   if { $merge(3rd_party) == "" } {
  182.     puts "Vendor Module not specified"
  183.     return
  184.   }
  185. #puts "merge(3rd_party)=$merge(3rd_party)"
  186.   if { $merge(from) == "" || \
  187.        $merge(to) == "" } {
  188.     puts "not all entries filled"
  189.     return
  190.   }
  191. #  puts "merge(from)=$merge(from)"
  192. #  puts "merge(to)=$merge(to)"
  193.   set merge(mod_dir) [exec pwd]
  194.   
  195.   set mess "This will merge differences between $merge(from) and\
  196.     $merge(to) of $merge(3rd_party) into $merge(mod_dir)
  197.     
  198. Are you sure?"
  199.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  200.   
  201.   if {$confirm == 0} {  
  202.     set mktemp "/tmp/[exec whoami][pid]"
  203.     set mktemp_dir $mktemp.dir
  204. #puts "mktemp_dir=$mktemp_dir"
  205.     catch {exec cvs checkout -d $mktemp_dir -r$merge(from) $merge(3rd_party)} \
  206.       view_this
  207.     view_output "CVS Checkout of temp file for $merge(3rd_party)" $view_this
  208.   
  209.     catch {rm -rf CVS_save}
  210.     eval exec mv CVS CVS_save
  211.     eval exec cp -R $mktemp_dir/CVS .
  212.     eval exec rm -rf $mktemp_dir
  213.   
  214. #puts "merge(mod_dir)=$merge(mod_dir)"
  215. #puts "merge(3rd_party)=$merge(3rd_party)"
  216.     catch {eval exec cvs checkout -d $merge(mod_dir) -j$merge(from) \
  217.       -j$merge(to) $merge(3rd_party) } view_this
  218.     view_output "CVS Module Level Merge of $merge(3rd_party) into $merge(mod_dir)" \
  219.       $view_this
  220.   
  221.     eval exec rm -rf CVS
  222.     eval exec mv CVS_save CVS
  223.   
  224.   wm withdraw .merge 
  225.   }     
  226.   
  227. }
  228.  
  229. proc unpack_tag_word { tag_word type tag_message} {
  230.   ##############################################################################
  231.   # Unpacks vendor and release tag information obtained from an RCS ,v file.
  232.   # In an RCS ,v file, between the keywords "symbols" and "locks" keywords,
  233.   # there are packed words with the following format:
  234.   #
  235.   #            tag_info:tag_ident
  236.   #
  237.   # where: tag_info is either the vendortag or releasetag which was entered
  238.   #        when a cvs checkin or import command was invoked. 
  239.   #        tag_ident is of the form: 
  240.   #          x.y.z for a vendor tag (3 subfields or 2 dots)
  241.   #          x.y,  x.y.z.w, or x.y.z.w.u.v for a release tag
  242.   #
  243.   # Called by:
  244.   #
  245.   # input: tag_word - word from a RCS ,v file between the "symbols" and "locks"
  246.   #                   keywords
  247.   # output: type - 0 if tag_word contains packed info on a release tag
  248.   #                1 if tag_word contains packed info on a vendor tag
  249.   # output: tag_message - a vendortag or releasetag as entered when a cvs 
  250.   #         checkin or import command was invoked
  251.   # 
  252.   # By: Eugene A. Lee, Aerospace Corporation
  253.   # Date: Sept 15, 1995
  254.   ##############################################################################
  255.   upvar $type typ $tag_message tag_m
  256.   set fields [split $tag_word :]
  257.   set tag_m [string trimleft [lindex $fields 0]]
  258.   set tag_num [string trimleft [lindex $fields 1]]
  259. #puts "tag_num=$tag_num"
  260.   # strip off any trailing ; character
  261.   regsub {;$} $tag_num "" tag_num
  262. #puts "   tag_num=$tag_num"
  263. #set xx [split $tag_num . ]
  264. #puts "xx=$xx $"
  265. #set len [llength $xx]
  266. #puts "len=$len"
  267.   if { [llength [split $tag_num . ]]  == 3 } {
  268.     set typ 1; # release tag
  269.   } else {
  270.     set typ 0; # vendor tag
  271.   }
  272. #puts "typ=$typ"
  273. }
  274. proc get_sort_list { in_list a_switch } {
  275.   ##################################################################################
  276.   # Compute a list which contains indices pointing to the order in which
  277.   # the input list is sorted. Sorted list is not returned.
  278.   # 
  279.   # input: in_list - input list
  280.   # input: a_switch - one switch to be used with the lsort command, i.e., -ascii, 
  281.   #                   -integer, -real, -increasing, -decreasing
  282.   #
  283.   # Called by: get_rv_tags
  284.   # return: indx_list - list of indices pointing to the order in which a local
  285.   #         copy of in_list is sorted
  286.   #
  287.   # By: Eugene Lee, Aerospace Corporation, Sept. 16, 1995
  288.   ###################################################################################
  289.   set tmp_list $in_list
  290.   set s_list [lsort $a_switch $tmp_list]
  291.   set xx_pat "#!#!"; # any pattern which will never be an element of in_list
  292.   set n [llength $in_list]
  293.  
  294.   for {set i 0} {$i < $n} {incr i} {
  295.   # Step through sorted list and look for a match with an element of in_list
  296.     set tmpi [lindex $s_list $i]
  297.     set j 0
  298.     while {$j < $n} {
  299.       # Step through input list
  300.       set tmpj [lindex $tmp_list $j]
  301.       set k $j
  302.       incr j
  303.       if {$tmpj == $xx_pat} {continue}
  304.       if {[string compare $tmpj $tmpi] == 0 } {
  305.         # found one
  306.         lappend index_list $k
  307.         set tmp_list [lreplace $tmp_list $k $k $xx_pat]
  308.         break
  309.       }
  310.     }
  311.   }
  312. #  puts "From get_sort_list, lindex_list=$index_list"
  313.   return $index_list
  314. }
  315.  
  316. proc sort_with_index_list { list s_list } {
  317.   # Called by get_rv_tag
  318. #puts "entered sort_with_index_list, list=$list  s_list=$s_list"
  319.   set n [llength $list]
  320.   if { $n != [llength $s_list] } {
  321.     puts "Error in sort_with_index_list, length of list & s_list are not equal"
  322.   }
  323.   for {set i 0} {$i < $n} {incr i} {
  324.     set j [lindex $s_list $i]
  325.     lappend sorted_list [lindex $list $j]
  326.   }
  327. #puts "sorted_list=$sorted_list"
  328.   return $sorted_list
  329. }
  330.  
  331. proc get_rv_tags { r_tag_list v_tag_list } {
  332.   #########################################################################
  333.   # Read all ,v files in a CVS repository module and extract all packed
  334.   # releasetag and vendortag words which are between the keywords "symbols"
  335.   # "locks".
  336.   #
  337.   # Packed releasetag word has the format:
  338.   #                releasetag:branch_id
  339.   #   where: releasetag was specified when the cvs import command was invoked. 
  340.   #          branch_id is of the forms: x.y, x.y.z.w, x.y.z.w.u.v, etc,
  341.   #          (odd number or subfields)
  342.   #
  343.   # Packed vendortag word has the format:
  344.   #                vendortag:branch_id 
  345.   #   where: vendortag was specified when the cvs import command was invoked. 
  346.   #          branch_id is of the forms: x.y.z (3 subfields or 2 dots)
  347.   #
  348.   # The output lists are created by processing each ,v file and appending to
  349.   # the appropriate output list only if the releasetag or vendortag information
  350.   # is new to the output list.
  351.   #
  352.   # Output: r_tag_list    - sorted releasetag list for the CVS module
  353.   # Output: v_tag_list    - sorted vendortag list for the CVS module
  354.   #
  355.   # Note: v_tag_list has no planned use for tkcvs yet. They are returned just
  356.   #       because this information was available.
  357.   #         
  358.   # By: Eugene A. Lee, Aerospace Corporation, November 12, 1995
  359.   #########################################################################
  360.   global merge
  361.   upvar $v_tag_list vtag_list
  362.   upvar $r_tag_list rtag_list
  363.   set first_module 1
  364. #puts "from get_rv_tags, pwd=[exec pwd]"
  365.   foreach module [glob *,v] {
  366. #puts ""
  367. #puts "module=$module"
  368.     set file [open $module r]
  369. #puts "file=$file"
  370.     while { [eof $file] == 0 } {
  371.       set line [gets $file]
  372. #puts "line=$line"
  373.       if {[string range $line 0 6] == "symbols" } { 
  374.         # Start of packed releasetag/vendortag
  375.         set line_list [split $line]
  376.         set nfields [llength $line_list]
  377.         catch {unset rlist};   # rlist = releasetag of current file
  378.         catch {unset vlist};   # vlist = vendortag for current file
  379.  
  380.         if {$nfields > 1 } {
  381.           # release and vendor tags are on the same line that "symbol" is on.
  382.           # (Assumes that next line will be "locks")
  383. #puts "format 1 line=$line"
  384.           for {set i 1} {$i < 3} {incr i} {
  385.             set tmp [string trimleft [lindex $line_list [expr $nfields - $i]]]
  386.             unpack_tag_word $tmp type tag_message
  387. #puts "tmp=$tmp"
  388. #puts "type=$type"
  389.             lappend tlist $type
  390.             if {$type == 0 } {
  391.               lappend rlist $tag_message
  392. #puts "rlist=$rlist"
  393.             }
  394.             if {$type == 1 } {
  395.               lappend vlist $tag_message
  396.             }
  397.           }
  398.           break; # Assumes that next line will be "locks"
  399.         } else {
  400.           # release and vendor tags on separate lines following the symbol line
  401. #puts "format 2"
  402.           while { 1 > 0 } {
  403.             set line [gets $file]
  404. #puts "line=$line"
  405.             if { [string range $line 0 4 ] == "locks" } {break}
  406.             unpack_tag_word $line type tag_message
  407. #puts "type=$type"
  408.             lappend tlist $type
  409.             if {$type == 0 } {
  410.               lappend rlist $tag_message
  411.             } else {
  412.               lappend vlist $tag_message
  413.             }
  414.           }
  415.         }          
  416.       }
  417.     }
  418.     close $file
  419.     # Compile master list of all releasetag and vendortag info for the CVS
  420.     # module
  421.     if {$first_module == 1 } {
  422. #puts "first_module entered"
  423.  
  424.       if { [info exists rlist] == 1 } {
  425.         set mrlist $rlist;     # mrlist = master releasetag list
  426. #puts "mrlist=$mrlist"
  427.       }
  428.       if { [info exists vlist] == 1 } {
  429. #puts "vlist=$vlist"
  430.         set mvlist $vlist;     # vrlist = master vendortag list
  431.       }
  432. #puts "mvlist=$mvlist"
  433.       set first_module 0
  434.     } else {
  435.       # Add to rtag_list only if it is a new release tag 
  436.       if { [info exists rlist] == 1 } {
  437.         for {set i 0} {$i < [llength $rlist] } {incr i} {
  438.           set tmp_rel [lindex $rlist $i]
  439.           set new_rel 1
  440.           foreach rel $mrlist {
  441. #puts "tmp_rel=$tmp_rel   rel=$rel"
  442.             if { [string compare $tmp_rel $rel ] == 0 } {
  443.               set new_rel 0
  444.               break
  445.             }
  446.           }
  447.           if { $new_rel == 1 } {
  448.             # Found a new release tag
  449. #puts "       $tmp_rel is a new release tag"
  450.              lappend mrlist [lindex $rlist $i]
  451. #puts "       mrlist=$mrlist"
  452.           }
  453.         }
  454.       }
  455.       # Add to vtag_list only if it is a new vendor tag 
  456.  
  457.       if { [info exists vlist] == 1 } {
  458.         for {set i 0} {$i < [llength $vlist] } {incr i} {
  459.           set tmp_ven [lindex $vlist $i]
  460.           set new_ven 1
  461.           foreach ven $mvlist {
  462. #puts "tmp_ven=$tmp_ven   ven=$ven"
  463.             if { [string compare $tmp_ven $ven ] == 0 } {
  464.               set new_ven 0
  465.               break
  466.             }
  467.           }
  468.           if { $new_ven == 1 } {
  469.             # Found a new vendor tag
  470. #puts "       $tmp_ven is a new vendor tag"
  471.              lappend mvlist [lindex $vlist $i]
  472. #puts "       mvlist=$mvlist"
  473.           }
  474.         }
  475.       }
  476.     }  
  477.   }
  478.   # Unsorteded master releasetag and versiontag lists have been found.
  479. #puts "unsorted release and version tag list have been found"
  480.   if { [info exists mrlist] == 1 } {
  481.     set rtag_list [lsort $mrlist]
  482. #puts "rtag_list=$rtag_list"
  483.   } else {
  484.     puts "no mrlist created"
  485.   }
  486.   if { [info exists mvlist] == 1 } {
  487.     set vtag_list [lsort $mvlist]
  488. #puts "vtag_list=$vtag_list"
  489.   } else {
  490.     puts "no mvlist created"
  491.   }
  492.   
  493. }
  494.  
  495.